IF FRE(-1) < 90000 THEN LOCATE 11,20:PRINT "Es ist leider zuwenig Speicher frei !" GOSUB Mouseclick:SYSTEM END IF ON BREAK GOSUB Ende:BREAK ON:ON ERROR GOTO Fehlerdiagnose SCREEN 1,640,200,2,2 WINDOW 1," Haushaltsbuch V 1.0 ============================= Geschrieben von Sauer Franz ",(0,10)-(631,186),16,1 LOCATE 12,26:PRINT "Systemkonfigurierung läuft !" MOUSE OFF : MENU OFF GOSUB Farbeinstellung GOSUB Outoffmemtext GOSUB Openlibrarys GOSUB Declarieren GOSUB Variablendim GOSUB Systemset GOSUB Systemsetload GOSUB Datalesen GOSUB Cursor CLS LOCATE 12,23:PRINT "Ich lese die Haushaltsdaten ein !" GOSUB Datenein CLS LOCATE 12,25:PRINT "Ich lese die Kontenliste ein !" GOSUB Konteneinlesen CLS LOCATE 12,26:PRINT "Ich erstelle die Menüleiste !" Menuinit: MENU OFF FOR x%=1 TO 14:m%(1,x%)=1:m%(2,x%)=1:NEXT GOSUB Menuleiste1 : GOSUB Menuleiste2 GOSUB Konteneinlesen GOSUB Machkonten IF sortflag%=0 THEN MENU 2,8,2:MENU 2,9,1::ELSE:MENU 2,8,1:MENU 2,9,2 IF detailflag%=1 THEN MENU 2,5,1:MENU 2,6,2 IF gesamtflag%=1 THEN MENU 2,5,2:MENU 2,6,1 ON MOUSE GOSUB Mousecheck ON MENU GOSUB Menuabfrage CLS Programmstart: GOSUB Windowclose3:fakt%=0 GOSUB Tabmaske GOSUB datum Menucheck: IF tagkorflag%=1 OR kontenaktiv%=1 OR fakt%=1 OR printakt%=1 OR mousep%>0 THEN MENU OFF ELSE MENU ON END IF MOUSE ON IF FRE(-1)<23000 THEN GOSUB Outoffmem SLEEP IF hlf%=1 THEN IF INKEY$<>"" THEN tdr=1:GOSUB Mouseposition END IF GOTO Menucheck Menuabfrage: leiste = MENU(0): punkte = MENU(1) IF hilfeflag%=1 THEN Hilferoutine Menuwahl: MENU OFF: MOUSE OFF ON leiste GOTO Larbeit,Lausgabe,Kontoakt,Kontoakt,Kontoakt,Kontoakt,Kontoakt Larbeit: ON punkte GOTO Tagein,Tagkor,Zeitmaske,datum,Filtertext,Wae,Datenakt,Konten,Sort,Import,Export,Sysst,Hilfe,Autor,Progende Lausgabe: ON punkte GOTO Tabausgabe,Tabprint,Nix,Msw2,Msw2,Msw2,Msw2,Msw2,Msw2,Msw2,Nix,Selektieren,Selinv,Selloe datum: windowtext$="Datumeingabe:":GOSUB Openwindow3 GOSUB Datumeingabe GOSUB Windowclose3 RETURN Kontoakt: IF eingmod=1 THEN kl=leiste:kp=punkte:eingmod=0:MENU ON:RETURN eingmod=3 GOSUB Menurefresh RETURN Nix: RETURN Tagkor: tagkorflag%=1 GOSUB Tabausgabe RETURN Tagkor1: IF show%(calcnr%)=0 THEN RETURN daten$=ds$(show%(calcnr%)) kl=VAL(LEFT$(daten$,1)):kp=VAL(MID$(daten$,2,1)) datumchange=1 datum$=MID$(daten$,4,8) komentar$=MID$(daten$,24,LEN(daten$)-32) komentar$=LEFT$(komentar$,40) betrag$=STR$(VAL(RIGHT$(daten$,10))) wtext3$="Tagesereignisse ändern:" WINDOW 3,wtext3$,(80,35)-(550,150),0,1 GOTO Weiter12 Tagein: MOUSE OFF IF ml%=0 THEN fehlertext$="Keine Eintragungen möglich. Konten fehlen !" GOTO Fehlermeldung END IF IF anzahl%>=datenmenge-1 THEN fehlertext$="Datei voll ! Bitte eine Neue beginnen.":GOTO Fehlermeldung END IF wtext3$="Tagesereignisse eintragen:(noch"+STR$(datenmenge-1-anzahl%)+" Eintragungen möglich !)" WINDOW 3,wtext3$,(80,35)-(550,150),0,1 LOCATE 7,9 PRINT "Bitte ein Konto aus Menuleiste auswählen !" MENU ON FOR x%=3 TO 7:IF m$(x%,1)<>"" THEN MENU x%,1,0 NEXT MENU 1,0,0:MENU 2,0,0 eingmod=1 WHILE eingmod=1:SLEEP:WEND IF eingmod=3 THEN FOR x%=3 TO 7:IF m$(x%,1)<>"" THEN MENU x%,1,m%(x%,1)+1 NEXT MENU 1,0,1:MENU 2,0,1 GOTO Windowclose3 END IF LOCATE 7,9:PRINT SPACE$(50) LOCATE 2,25 Weiter12: GOSUB Datumeingabe IF datum$dzeitende$ THEN Weiter12 GOSUB Wochentagberechnung CLS LOCATE 2,11:PRINT "Eintragung für "wt$(wt%)" den "datum$ center=28-(LEN(m$(kl,kp))+40)/2 IF tagkorflag%=0 THEN IF INSTR(kontoart$(kl,kp),"u")>0 THEN uekl=kl:uekp=kp LOCATE 4,center:PRINT"Überweisung vom Konto "m$(kl,kp)" ! Bitte 2.Konto wählen" MENU ON: eingmod=1: WHILE eingmod=1:SLEEP:WEND IF eingmod=3 THEN FOR x%=3 TO 7:IF m$(x%,1)<>"" THEN MENU x%,1,m%(x%,1)+1 NEXT MENU 1,0,1:MENU 2,0,1 GOTO Windowclose3 END IF LOCATE 4,2:PRINT SPACE$(70) LOCATE 4,center:PRINT"Diese Eingabe wird auf das Konto "m$(kl,kp)" ueberwiesen" laenge=36:GOTO Weiter3 END IF END IF laenge=40 LOCATE 4,center:PRINT"Diese Eingabe wird auf das Konto "m$(kl,kp)" verbucht" Weiter3: LOCATE 6,3:PRINT"Kommentar:":LOCATE 6,47:PRINT"Betrag" LOCATE 8,3 msgs$="":IF tagkorflag%=1 THEN msgs$=komentar$ type%=0:GOSUB Superinput:komentar$=msgs$ IF msgs$="" THEN Weiter16 msgs$="" IF tagkorflag%=1 THEN msgs$=betrag$ 122 LOCATE 8,47:laenge=10 type%=1:GOSUB Superinput:betrag$=msgs$ IF betrag$="" THEN IF funktion=9 THEN msgs$=STR$(summe) ELSE msgs$=STR$(rechenwert) END IF GOTO 122 END IF IF VAL(betrag$)>=999999 OR VAL(betrag$)<=-999999 THEN LOCATE 8,47:PRINT SPACE$(10):GOTO 122 END IF IF tagkorflag%=1 THEN Tagkorbest ttextrl=12:ttextrp=18:ttextfl=12:ttextfp=35:GOSUB Bestaetigung mousep%=1:RETURN Mp1: mousep%=0 IF fehler=0 THEN IF VAL(betrag$)=0 THEN fehlertext$="Beträge von 0.00 "+waehrung$+" sind nicht abspeicherbar !" GOSUB Geisterkiller:GOTO Fehlermeldung END IF GOSUB Abspeichern END IF Weiter16: GOSUB Geisterkiller GOTO Windowclose3 Geisterkiller: FOR x%=3 TO 7:IF m$(x%,1)<>"" THEN MENU x%,1,m%(x%,1)+1 NEXT MENU 1,0,1:MENU 2,0,1 RETURN Tagkorbest: request%=3 ttextrl=12:ttextrp=10:ttextwl=12:ttextwp=25:ttextfl=12:ttextfp=40 GOSUB Bestaetigung:mousep%=2:RETURN Mp2: mousep%=0 request%=0 IF fehler=2 THEN GOSUB Eintragen:GOTO Windowclose3 IF fehler=0 THEN GOSUB Eintragen:GOSUB Windowclose3:GOTO Sort END IF tagkorflag%=0:WINDOW OUTPUT 1:GOSUB Listen1:GOTO Windowclose3 Eintragen: kn$=RIGHT$(STR$(kl*10+kp),2) ds$(show%(calcnr%))=kn$+" "+datum$+" "+wt$(wt%)+" "+komentar$+" "+betrag$ WINDOW OUTPUT 1:GOSUB Listen1:WINDOW 3 RETURN Datenakt: MENU OFF:MOUSE OFF WINDOW 3,"Dateien Aktualisieren:",(80,50)-(550,140),0,1 PALETTE 3,0,0,0 LOCATE 5,16:PRINT "Bitte Dateinamen eingeben !" LINE (54,50)-(408,68),3,b:LINE (69,54)-(393,64),3,b PAINT (55,51),3 PALETTE 3,r(3),g(3),b(3) IF dateiname$="" THEN dateiname$="Haushaltsdaten/" altdn$=dateiname$ LOCATE 8,10:laenge=38:msgs$=dateiname$:GOSUB Superinput:dateiname$=msgs$ diskfehler=0 CLOSE #2 OPEN dateiname$ FOR INPUT AS #2 CLOSE #2 IF diskfehler=2 THEN diskfehler=0 GOTO Fehlermeldung END IF IF diskfehler<1 THEN GOTO Dateiwechsel ' Datei bereits vorhanden WINDOW 3,"Dateien Aktualisieren:",(80,50)-(550,140),0,1 LOCATE 4,12:PRINT "Ich habe diese Datei nicht gefunden." LOCATE 6,12:PRINT "Wollen Sie die Datei neu erstellen ?" ttextrl=9:ttextrp=20:ttextfl=9:ttextfp=34:mskip=0:GOSUB Bestaetigung mousep%=3:RETURN Mp3: mousep%=0 IF fehler=1 THEN dateiname$=altdn$:GOTO Windowclose3 Machedatei: CLS PALETTE 3,0,0,0 LINE (7,36)-(457,52),3,bf LOCATE 6,3:COLOR 0,3:PRINT "Die Datei soll vom " LOCATE 6,22:COLOR 1,0:PRINT " " LOCATE 6,33:COLOR 0,3:PRINT" bis " LOCATE 6,38:COLOR 1,0:PRINT " " LOCATE 6,50:COLOR 0,3:PRINT"dauern." PALETTE 3,r(3),g(3),b(3):COLOR 1,0 fehlerpos=9 Weiter5: dzeitstart$="86-01-01":dzeitende$="99-12-31" LOCATE 6,22:laenge=8:msgs$=zeitstart$:type%=1:GOSUB Superinput zeitstart$=msgs$ checkdat$=dzeitstart$:GOSUB Datumcheck IF fehler=1 THEN fehler=0:GOTO Weiter5 Weiter6: LOCATE 6,38:laenge=8:msgs$=zeitende$:type%=1:GOSUB Superinput zeitende$=msgs$ checkdat$=dzeitende$:GOSUB Datumcheck IF fehler=1 THEN fehler=0:GOTO Weiter6 IF zeitstart$>=zeitende$ THEN Weiter5 fehler=3 ttextrl=10:ttextrp=20:ttextfl=10:ttextfp=34:GOSUB Bestaetigung mousep%=4:RETURN Mp4: mousep%=0 IF fehler=1 THEN Machedatei CLS PALETTE 3,0,0,0 LOCATE 5,9:PRINT "Bitte den Namen der Kontenliste eingeben !" LINE (54,50)-(408,68),3,b:LINE (69,54)-(393,64),3,b:PAINT (55,51),3 PALETTE 3,r(3),g(3),b(3) IF Kontenliste$="" THEN Kontenliste$="Haushaltskonten/" alkoli$=Kontenliste$ LOCATE 8,10:laenge=38:msgs$=Kontenliste$:GOSUB Superinput Kontenliste$=msgs$ diskfehler=0 CLOSE #2 OPEN Kontenliste$ FOR INPUT AS #2 CLOSE #2 IF diskfehler=0 THEN Weiter9 fehlertext$="Kontenliste nicht vorhanden ! Bitte erstellen." dzeitstart$=d0zeitstart$:dzeitende$=d0zeitende$ Kontenliste$=alkoli$:dateiname$=altdn$ GOTO Fehlermeldung Weiter9: diskfehler=0:CLOSE #2 OPEN dateiname$ FOR OUTPUT AS#2 IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Weiter9 PRINT #2,"00 "zeitstart$" "zeitende$" "Kontenliste$ IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Weiter9 CLOSE #2 Dateiwechsel: WINDOW 3,"Dateiwechsel:",(80,50)-(550,140),0,1 CLS:LOCATE 6,17:PRINT "Lese Daten, bitte Geduld !" GOSUB Datenein CLOSE #2 IF diskfehler>0 THEN Windowclose3 diskfehler=0 Kontenliste$=LEFT$(RIGHT$(ds$(0),LEN(ds$(0))-21),36) center=19-LEN(Kontenliste$)/2 windowtext$="Dateiwechsel:":GOSUB Openwindow3 LOCATE 6,center:PRINT "Lese Kontenliste "Kontenliste$" ein !" OPEN Kontenliste$ FOR INPUT AS #2 CLOSE #2 IF diskfehler>0 THEN fehlertext$="Erforderliche Kontenliste nicht vorhanden !" Kontenliste$=alkoli$ GOTO Fehlermeldung END IF GOSUB Konteneinlesen GOSUB Machkonten GOSUB Windowclose3 GOSUB Tabmaske RETURN Abspeichern: diskfehler=0:CLOSE #2 OPEN dateiname$ FOR APPEND AS #2 IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Abspeichern IF diskfehler>0 THEN fehlertext$="Kann nicht Abspeichern. Keine Datei aktuallisiert !" GOTO Fehlermeldung END IF IF INSTR(kontoart$(kl,kp),"-")>0 THEN neg$="-" :ELSE neg$="" daten$=RIGHT$(STR$(kl*10+kp),2)+" "+datum$+" "+wt$(wt%)+" "+komentar$+" "+neg$+betrag$ anzahl%=anzahl%+1 ds$(anzahl%)=RIGHT$(daten$,LEN(daten$)) PRINT#2,daten$ IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Abspeichern IF INSTR(kontoart$(uekl,uekp),"u")>0 THEN IF INSTR(kontoart$(uekl,uekp),"-")>0 THEN neg$="-"::ELSE:neg$="" daten$=RIGHT$(STR$(uekl*10+uekp),2)+" "+datum$+" "+wt$(wt%)+" (U) "+komentar$+" "+neg$+betrag$ PRINT#2,daten$ uekl=0:uekp=0 anzahl%=anzahl%+1 ds$(anzahl%)=RIGHT$(daten$,LEN(daten$)) END IF CLOSE#2 RETURN Tabausgabe: WINDOW 1:GOSUB Tabkopf LINE (36,22)-(625,151),0,bf:LINE(8,36)-(27,138),0,bf tabaktuell=1:tabaktiv=1 LOCATE 11,23:PRINT"Bitte etwas Geduld ich suche Daten !" IF filterflag%=1 THEN LOCATE 13,23:PRINT"Achtung !!!!! Filterfunktion aktiv ." END IF IF sortflag%=0 THEN GOSUB Kontenliste gesamtbe=0 z%=0 :bildzeilen=16 gesamtakt%=0 ERASE show$,show%,calc%:DIM show$(30),show%(datenmenge),calc%(datenmenge) IF tagkorflag%=1 THEN GOSUB Suchrutine2:GOTO Weiter4 IF monatflag%=1 THEN gesamtakt%=1:GOSUB Suchrutine4:GOTO Weiter4 IF gesamtflag%=1 THEN gesamtakt%=1:GOSUB Suchrutine3:GOTO Weiter4 IF sortflag%=0 THEN GOSUB Suchrutine1 IF sortflag%=1 THEN GOSUB Suchrutine2 Weiter4: LOCATE 11,20:PRINT SPACE$(40) LOCATE 13,20:PRINT SPACE$(40) GOSUB Berechnung :IF z%=0 THEN RETURN prozent%=bildzeilen/(z%/100):IF prozent%>100 THEN prozent%=100 LINE(10,37)-(25,37+prozent%),2,bf:GET(10,37)-(25,37+prozent%),balken% mitte=prozent%/2:x=10:yx=37:showstart=1 LOCATE 12,20:PRINT SPACE$(40) GOTO Listen1 Suchrutine1: z%=0 FOR y%=0 TO klg% FOR x%=1 TO anzahl% IF koliste%(y%)=VAL(LEFT$(ds$(x%),2)) THEN d$= MID$(ds$(x%),4,8) IF zeitstart$==d$ THEN IF filterflag%=1 THEN IF INSTR(ds$(x%),Filtertext$)>0 THEN z%=z%+1:show%(z%)=x%:w=VAL(RIGHT$(ds$(x%),10)) gesamtbe=gesamtbe+w END IF ELSE z%=z%+1:show%(z%)=x%:w=VAL(RIGHT$(ds$(x%),10)) gesamtbe=gesamtbe+w END IF END IF END IF NEXT x%,y% RETURN Suchrutine2: z%=0 FOR x%=1 TO anzahl% x1%= VAL(LEFT$(ds$(x%),1)) y1%= VAL(MID$(ds$(x%),2,1)) IF m%(x1%,y1%)=1 THEN d$= MID$(ds$(x%),4,8) IF zeitstart$==d$ THEN IF filterflag%=1 THEN IF INSTR(ds$(x%),Filtertext$)>0 THEN z%=z%+1:show%(z%)=x%:w=VAL(RIGHT$(ds$(x%),10)) gesamtbe=gesamtbe+w END IF ELSE z%=z%+1:show%(z%)=x%:w=VAL(RIGHT$(ds$(x%),10)) gesamtbe=gesamtbe+w END IF END IF END IF NEXT RETURN Suchrutine3: ERASE gges:DIM gges(7,6) FOR x%=1 TO anzahl% gh%=VAL(LEFT$(ds$(x%),1)):gu%=VAL(MID$(ds$(x%),2,1)) IF m%(gh%,gu%)=1 THEN d$= MID$(ds$(x%),4,8) IF zeitstart$==d$ THEN IF filterflag%=1 THEN IF INSTR(ds$(x%),Filtertext$)>0 THEN w=VAL(RIGHT$(ds$(x%),10)):gges(gh%,gu%)=gges(gh%,gu%)+w gesamtbe=gesamtbe+w:knum$(y%)=LEFT$(ds$(x%),2) END IF ELSE w=VAL(RIGHT$(ds$(x%),10)):gges(gh%,gu%)=gges(gh%,gu%)+w gesamtbe=gesamtbe+w:knum$(y%)=LEFT$(ds$(x%),2) END IF END IF END IF NEXT x% z%=0 GOSUB Wochentagberechnung FOR y%=3 TO 7 FOR x%=1 TO 6 IF gges(y%,x%)<>0 THEN z%=z%+1 show$(z%)=RIGHT$(STR$(y%),1)+RIGHT$(STR$(x%),1)+" "+datum$ show$(z%)=show$(z%)+" "+wt$(wt%)+" "+m$(y%,x%)+" Gesamt " show$(z%)=show$(z%)+zeitstart$+" bis "+zeitende$ show$(z%)=show$(z%)+" "+STR$(gges(y%,x%)) END IF NEXT x%,y% RETURN Suchrutine4: jahre%=0 FOR x%=VAL(LEFT$(zeitstart$,2)) TO VAL(LEFT$(zeitende$,2)) jahre%=jahre%+1 NEXT IF jahre%>4 THEN RETURN ERASE show$:DIM show$(12+(jahre%*12)) ERASE mges:DIM mges(jahre%-1,12) FOR x%=1 TO anzahl% IF m%(VAL(LEFT$(ds$(x%),1)),VAL(MID$(ds$(x%),2,1)))=1 THEN d$= MID$(ds$(x%),4,8) IF zeitstart$==d$ THEN IF filterflag%=1 THEN IF INSTR(ds$(x%),Filtertext$)>0 THEN w=VAL(RIGHT$(ds$(x%),10)) mon%=VAL(MID$(d$,4,2)):jahr%=VAL(LEFT$(d$,2))-VAL(LEFT$(zeitstart$,2)) mges(jahr%,mon%)=mges(jahr%,mon%)+w gesamtbe=gesamtbe+w END IF ELSE w=VAL(RIGHT$(ds$(x%),10)) mon%=VAL(MID$(d$,4,2)):jahr%=VAL(LEFT$(d$,2))-VAL(LEFT$(zeitstart$,2)) mges(jahr%,mon%)=mges(jahr%,mon%)+w gesamtbe=gesamtbe+w END IF END IF END IF NEXT x% z%=0 GOSUB Wochentagberechnung FOR x%=0 TO jahre%-1 FOR y%=1 TO 12 IF mges(x%,y%)<>0 THEN z%=z%+1 show$(z%)="00 "+datum$+" "+wt$(wt%)+" Monatliche Abrechnung für " show$(z%)=show$(z%)+monat$(y%)+STR$(VAL(LEFT$(zeitstart$,2))+x%) show$(z%)=show$(z%)+" "+STR$(mges(x%,y%)) END IF NEXT y%,x% RETURN Filtertext: WINDOW 3,"Daten Filter",(50,55)-(580,123),0,1 meldung$="Bitte Text nach dem du suchen willst eingeben !" center=34-(LEN(meldung$)/2) LOCATE 2,center :PRINT meldung$ LINE (60,19)-(470,36),3,b:LINE(70,21)-(460,34),3,b:PAINT (62,25),3 LOCATE 4,11:laenge=40:msgs$=Filtertext$ type%=0:GOSUB Superinput:Filtertext$=msgs$ IF Filtertext$="" THEN Windowclose3 ttextrl=7:ttextrp=23:ttextfl=7:ttextfp=40:GOSUB Bestaetigung mousep%=5:RETURN Mp5: mousep%=0 IF fehler=1 THEN Filtertext$="" GOTO Windowclose3 Selektieren: x%=0 :ok%=0 WHILE x%<=z% x%=x%+1 IF calc%(x%)=1 THEN ok%=1 WEND IF ok%=0 THEN fehlertext$="Ich habe keine Selektierten Daten gefunden !" GOTO Fehlermeldung END IF LINE (36,22)-(625,151),0,bf:LINE(8,36)-(27,138),0,bf LOCATE 11,23:PRINT"Bitte Geduld ich selektiere Daten !" selektflag=1 sz%=1:gesamtbe=0 FOR x%=1 TO z% IF gesamtakt%=0 THEN IF calc%(x%)=1 THEN show%(sz%)=show%(x%) gesamtbe=gesamtbe+VAL(RIGHT$(ds$(show%(x%)),10)) sz%=sz%+1 END IF END IF IF gesamtakt%=1 THEN IF calc%(x%)=1 THEN show$(sz%)=show$(x%) gesamtbe=gesamtbe+VAL(RIGHT$(show$(x%),10)) sz%=sz%+1 END IF END IF NEXT IF gesamtakt%=0 THEN FOR x%=sz% TO z%:show%(x%)=0:NEXT:z%=sz%-1 ELSE FOR x%=sz% TO z%:show$(x%)="":NEXT:z%=sz%-1 END IF ERASE calc% :DIM calc%(datenmenge) GOTO Weiter4 Selloe: ERASE calc%:DIM calc%(datenmenge) GOSUB Listen1 RETURN Selinv: FOR x%=1 TO z%:calc%(x%)=1-calc%(x%):NEXT GOSUB Listen1 RETURN Listen: showstart=INT((yx-37)*(z%/100)) IF showstart<1 OR yx<39 THEN showstart=1 IF prozent%<100 THEN IF yx+prozent%>136 THEN showstart=z%-(bildzeilen-1) END IF Listen1: MOUSE OFF LINE(35,22)-(626,151),0,bf:calcpos%=0 FOR calcnr%=showstart TO showstart+bildzeilen-1 GOSUB Listenprint calcpos%=calcpos%+1 NEXT summe=0:rechenwert=gesamtbe:calcmodus%=1 RETURN Listenprint: IF calc%(calcnr%)=1 THEN COLOR 2::ELSE COLOR 1 LOCATE 4+calcpos%,6 IF gesamtakt%=0 THEN IF show%(calcnr%)<>0 THEN rechenwert=VAL(RIGHT$(ds$(show%(calcnr%)),10)) texti$=MID$(ds$(show%(calcnr%)),3,LEN(ds$(show%(calcnr%)))-12) CALL Text (WINDOW(8),SADD(texti$),LEN(texti$)) LOCATE 4+calcpos%,68:PRINT USING "#######.##";rechenwert END IF ELSE IF show$(calcnr%)<>"" THEN rechenwert=VAL(RIGHT$(show$(calcnr%),10)) texti$=MID$(show$(calcnr%),3,LEN(show$(calcnr%))-12) CALL Text (WINDOW(8),SADD(texti$),LEN(texti$)) LOCATE 4+calcpos%,68:PRINT USING "#######.##";rechenwert END IF END IF COLOR 1 RETURN Korrbalken: PUT (10,yx),balken% yx=(showstart-1)/z%*100+37 PUT (10,yx),balken% RETURN Scrolldown: IF showstart<=1 THEN RETURN showstart=showstart-1 GOSUB Korrbalken calcpos%=0:calcnr%=showstart SCROLL (36,24)-(625,151),0,8 GOSUB Listenprint RETURN Scrollup: IF showstart+bildzeilen-1>=z% THEN RETURN showstart=showstart+1 GOSUB Korrbalken calcpos%=bildzeilen-1:calcnr%=showstart+bildzeilen-1 SCROLL (36,24)-(625,151),0,-8 GOSUB Listenprint RETURN Mousecheck: MENU OFF:x=MOUSE(0) IF ed%=1 THEN Mcp IF kontenaktiv%=1 THEN Kontenmousecheck IF mousep%>0 THEN Mouseposition IF fakt%=1 THEN fakt%=0:GOTO Windowclose3 IF hilfeflag%=1 THEN hilfeflag%=0:MOUSE STOP :GOTO Windowclose3 IF WINDOW(0)=1 AND tabaktiv<>0 THEN WINDOW 1 IF MOUSE(1)>10 AND MOUSE(1)<25 AND MOUSE(2)>37 AND MOUSE(2)<137 THEN GOSUB Showzoom:GOTO Listen Scrollrepeat: IF MOUSE(3)>10 AND MOUSE(3)<25 THEN IF MOUSE(4)>27 AND MOUSE(4)<37 THEN GOSUB Scrolldown IF MOUSE(4)>137 AND MOUSE(4)<147 THEN GOSUB Scrollup IF MOUSE(0)=-1 THEN Scrollrepeat RETURN END IF IF MOUSE(2)>157 AND MOUSE(2)<171 THEN Rechnerfunktion IF MOUSE(2)>=24 AND MOUSE(2)<=150 AND MOUSE(1)>40 AND MOUSE(1)<620 THEN Rechner END IF IF WINDOW(0)=2 AND grafikaktiv%=1 THEN WINDOW 2 MOUSE STOP:GOTO Grafikselekt END IF RETURN Rechnertasten: COLOR 0,1 LOCATE 21,3:PRINT "ALT" :LOCATE 21,10:PRINT "CE":LOCATE 21,16:PRINT "IN" LOCATE 21,22:PRINT "OUT":LOCATE 21,29:PRINT "+":LOCATE 21,35:PRINT "-"; PRINT PTAB(324)"*":LOCATE 21,48:PRINT "/":LOCATE 21,54:PRINT "=" COLOR 1,0 LOCATE 21,58:PRINT "Gesamt "waehrung$ RETURN Berechnung: LOCATE 21,68:PRINT USING "#######.##";gesamtbe:rechenwert=gesamtbe IF tabaktuell=2 OR z%<>0 THEN RETURN tagkorflag%=0 fehlertext$="Ich habe leider keine Daten gefunden" IF jahre%>4 THEN jahre%=0:fehlertext$="Monatsabrechnungen können nur über 4 Jahre gehen !" GOTO Fehlermeldung Showzoom: IF MOUSE(0)<=-1 THEN Weiter2 IF MOUSE(0)=0 THEN RETURN GOTO Showzoom Weiter2: IF MOUSE(1)< 0 OR MOUSE(1)>100 THEN Showzoom IF ABS(yx-(MOUSE(2)-mitte)) < 1 THEN Showzoom GOSUB Movebalken GOTO Showzoom Movebalken: PUT(10,yx),balken% yx=MOUSE(2)-mitte IF MOUSE(2)-mitte<37 THEN yx=37 IF MOUSE(2)+mitte>137 THEN yx=137-mitte*2 PUT(10,yx),balken% RETURN Datumeingabe: LOCATE 9,20:PRINT SPACE$(20) LOCATE 6,10:PRINT"Bitte Datum im Format JJ-MM-TT eingeben" LOCATE 7,32:laenge=8:msgs$=datum$:type%=1 GOSUB Superinput:datum$=msgs$ IF datum$="" THEN fehler=3 :RETURN fehlerpos=9:checkdat$=datum$ GOSUB Datumcheck:datum$=checkdat$ IF fehler=1 THEN fehler=0 :GOTO Datumeingabe LOCATE 6,10:PRINT SPACE$(40) LOCATE 7,30:PRINT SPACE$(20) GOSUB Wochentagberechnung MENU 1,4,1,"Datum ändern ("+datum$+") " RETURN Wochentagberechnung: jj=1900+VAL(LEFT$(datum$,2)):mm=VAL(MID$(datum$,4,2)):tt=VAL(RIGHT$(datum$,2)) IF mm<3 THEN smj=(366+mm)-(INT(365.25*jj)-INT(365.25*(jj-1)))::ELSE:smj=0 sj=INT(365.25*jj)-INT(jj/100)+INT(jj/400)+31*(mm-1)-INT(0.4*mm+2.3-smj)+tt jj=sj+1721060:wt%=jj-INT(jj/7)*7 RETURN Menuleiste1: MENU 1,0,1,"Arbeit" MENU 1,1,1,"Tagesereignisse eingeben" MENU 1,2,1,"Tagesereignisse ändern " MENU 1,3,1,"Zeitmaske eingeben " MENU 1,4,1,"Datum ändern ("+datum$+") " MENU 1,5,1,"Filtertext eingeben " MENU 1,6,1,"Währungszeichen ändern " MENU 1,7,1,"Dateien verwalten " MENU 1,8,1,"Kontenlisten verwalten " MENU 1,9,1,"Daten sortieren " MENU 1,10,1,"Daten importieren " MENU 1,11,1,"Daten exportieren " MENU 1,12,1,"Systemstatus " MENU 1,13,1,"Hilfe ( Beschreibung ) " MENU 1,14,1,"Autor !!!!!!!!!!!!!!!!! " MENU 1,15,1,"Programm beenden " RETURN Menuleiste2: MENU 2,0,1,"Ausgabe" MENU 2,1,m%(2,1), "Tabelle Bildschirm " MENU 2,2,m%(2,2), "Tabelle Drucken " MENU 2,3,m%(2,3), "=====================" MENU 2,4,m%(2,4), " Alle Konten AN/AUS " MENU 2,5,m%(2,5), " Gesamt " MENU 2,6,m%(2,6), " Detailiert " MENU 2,7,m%(2,7), " Filter EIN/AUS " MENU 2,8,m%(2,8), " Sortiert n. Konten " MENU 2,9,m%(2,9), " Sortiert n. Datum " MENU 2,10,m%(2,10)," Monatsabrechnung " MENU 2,11,m%(2,11),"=====================" MENU 2,12,m%(2,12),"Selektieren " MENU 2,13,m%(2,13),"Selekt invertieren " MENU 2,14,m%(2,14),"Selekt löschen " RETURN Machkonten: allkonflag%=0:MENU 2,4,1 FOR x%=3 TO 7:MENU x%,0,0,"":NEXT FOR leiste=3 TO ml%+2 :MENU leiste,0,1,m$(leiste,1) MENU leiste,1,m%(leiste,1)+1," "+LEFT$(m$(leiste,1)+" ",9) FOR x%=2 TO ma%(leiste) MENU leiste,x%,m%(leiste,x%)+1," "+LEFT$(m$(leiste,x%)+" ",9) NEXT x%,leiste RETURN Msw2: IF punkte=5 THEN gesamtflag%=1:detailflag%=0:monatflag%=0 MENU 2,5,2:MENU 2,6,1:MENU 2,10,1 END IF IF punkte=6 THEN detailflag%=1:gesamtflag%=0:monatflag%=0 MENU 2,5,1:MENU 2,6,2:MENU 2,10,1 END IF IF punkte=10 THEN monatflag%=1:gesamtflag%=0:detailflag%=0 MENU 2,10,2:MENU 2,6,1:MENU 2,5,1 END IF IF punkte=8 THEN sortflag%=0:MENU 2,8,2:MENU 2,9,1 IF punkte=7 THEN filterflag%=1-filterflag%:MENU 2,7,filterflag%+1 IF punkte=9 THEN sortflag%=1:MENU 2,8,1:MENU 2,9,2 IF punkte=4 THEN allkonflag%=1-allkonflag%:tabaktuell=2-allkontenflag%*2:MENU 2,4,allkonflag%+1 tabaktuell=0 FOR x%=3 TO ml%+2 FOR y%=1 TO ma%(x%) IF m$(x%,y%)<>"" THEN m%(x%,y%)=allkonflag%:MENU x%,y%,allkonflag%+1 NEXT y%,x% END IF RETURN Menurefresh: tabaktuell=0 IF punkte<2 THEN m%(leiste,1)=1-m%(leiste,1) FOR x%=1 TO ma%(leiste) m%(leiste,x%)=m%(leiste,1) IF m$(leiste,x%)<>"" THEN MENU leiste,x%,m%(leiste,x%)+1 NEXT ELSE: m%(leiste,punkte)=1-m%(leiste,punkte) IF m$(leiste,punkte)<>"" THEN MENU leiste,punkte,m%(leiste,punkte)+1 END IF RETURN Kontenliste: ERASE koliste%:ERASE koliste$:DIM koliste$(30):DIM koliste%(30) klg%=0 FOR x%=3 TO ml%+2:FOR y%=2 TO ma%(x%) IF m%(x%,y%)=1 THEN klg%=klg%+1 koliste$(klg%)=m$(x%,y%) koliste%(klg%)=x%*10+y% END IF NEXT y%,x% RETURN Zeitmaske: WINDOW 3,"Zeitmaske eingeben",(80,35)-(550,150),0,1 LOCATE 3,8:PRINT "Aktuelle Zeitmaske von "zeitstart$" bis "zeitende$" 1200 fehler=0: LOCATE 6,14:PRINT "Ausgaben vom (JJ-MM-TT) "; laenge=8:msgs$=zeitstart$:type%=1:GOSUB Superinput :checkdat$=msgs$ IF checkdat$="" THEN Windowclose3 fehlerpos=10:GOSUB Datumcheck IF fehler=1 THEN GOTO 1200 zeitstart$=msgs$ 1201 fehler=0: LOCATE 8,23:PRINT "bis (JJ-MM-TT) "; laenge=8:msgs$=zeitende$:type%=1:GOSUB Superinput :checkdat$=msgs$ IF checkdat$="" THEN Windowclose3 fehlerpos=10:GOSUB Datumcheck IF fehler=1 THEN GOTO 1201 zeitende$=msgs$ ttextrl=12:ttextrp=18:ttextfl=12:ttextfp=35:GOSUB Bestaetigung mousep%=6:RETURN Mp6: mousep%=0 IF fehler=1 THEN GOTO Zeitmaske WINDOW 1:GOSUB Tabkopf GOSUB Systemsetsave GOTO Windowclose3 Datumcheck: jj$=(LEFT$(checkdat$,2)):mm$=(MID$(checkdat$,4,2)):tt$=(RIGHT$(checkdat$,2)) jj=VAL(jj$):mm=VAL(mm$):tt=VAL(tt$) IF LEN(checkdat$)>8 OR LEN(checkdat$)<8 THEN Datumfehler IF MID$(checkdat$,3,1)<> "-" OR MID$(checkdat$,6,1)<> "-" THEN Datumfehler IF checkdat$dzeitende$ THEN Datumfehler IF jj<80 OR jj>99 THEN Datumfehler IF mm<1 OR mm>12 THEN Datumfehler IF tt<1 OR tt>31 THEN Datumfehler RETURN Datumfehler: fehler =1 LOCATE fehlerpos,5:PRINT SPACE$(40) LOCATE fehlerpos,24:PRINT"Datum falsch" FOR x=1 TO 1000:NEXT LOCATE fehlerpos,24:PRINT SPACE$(13) RETURN Mouseclick: MOUSE OFF dummy=MOUSE(0) WHILE MOUSE(0)<>-1:SLEEP:WEND dummy=MOUSE(3):dummy=MOUSE(3) MOUSE ON RETURN Ende: GOSUB Windowclose3:CLS:LIBRARY CLOSE:SYSTEM Progende: windowtext$="Programm beenden :":GOSUB Openwindow3 LOCATE 4,25:PRINT "Good bye !" ttextrl=7:ttextrp=18:ttextfl=7:ttextfp=35:GOSUB Bestaetigung mousep%=7:RETURN Mp7: mousep%=0 IF fehler=0 THEN Ende GOTO Windowclose3 Operationsmeldung: WINDOW CLOSE 3 WINDOW 3,"Operationsmeldung",(122,80)-(512,118),0,1 center=25-(LEN(operationstext$)/2) LOCATE 3,center :PRINT operationstext$ IF flag=1 THEN flag=0:RETURN GOSUB Mouseclick GOTO Windowclose3 Fehlermeldung: SOUND 1500,2,255,3:fakt%=1 WINDOW 3,"Fehlerdiagnose",(82,80)-(552,120),0,1 center1=1 center=30-(LEN(fehlertext$)/2) IF fehlertext1$<>"" THEN center1=30-(LEN(fehlertext1$)/2) LOCATE 3,center :COLOR 2:PRINT fehlertext$:COLOR 1 LOCATE 4,center1:COLOR 2:PRINT fehlertext1$:COLOR 1 fehlertext1$="":fehlertext$="" fehlerflag=1 IF diskfehler=4 THEN GOSUB Mouseclick RETURN Fehlerdiagnose: IF ERR=61 THEN fehlertext$="Diskette voll ! Bitte auf DIESER Platz schaffen !" diskfehler=4 RESUME NEXT END IF IF ERR=70 THEN fehlertext$="Ihre Diskette ist schreibgeschützt." fehlertext1$="Bitte Schreibschutz entfernen !" diskfehler=4 RESUME NEXT END IF IF ERR=53 THEN fehlertext$="Ich kann diese Datei nicht finden !" diskfehler=1:RESUME NEXT END IF IF ERR=68 THEN fehlertext$="Mit dem Drucker stimmt etwas nicht !" druckfehler=1 RESUME NEXT END IF IF ERR=6 OR ERR=68 OR ERR=11 OR ERR=58 THEN RESUME NEXT IF ERR=57 THEN RESUME Windowclose3 IF ERR=23 OR ERR=15 THEN fehlertext$="Schadhafte Datei ! (Korrigieren mit 'Ed')" GOSUB Fehlermeldung diskfehler=2 RESUME Windowclose3 END IF IF ERR=64 THEN fehlertext$="Falscher Dateiname !" GOSUB Fehlermeldung diskfehler=1:CLOSE #2 RESUME NEXT END IF IF ERR=5 OR ERR=52 THEN diskfehler=2:CLOSE #2 fehlertext$="Falsche Dateinummer" RESUME NEXT END IF IF ERR=55 THEN CLOSE #2:CLOSE #3:RESUME NEXT IF ERR=14 OR ERR=7 THEN RESUME Outoffmem GOTO Guru Tabmaske: GOSUB Screendown CLS LINE(3,21)-(32,152),3,b:LINE(4,21)-(31,152),3,b FOR x=1 TO 2 LINE(5-x,5-x)-(625+x,17+x),3,b LINE(5-x,156-x)-(625+x,170+x),3,b LINE(33+x,21)-(625+x,152),3,b NEXT y=158:y1=168:FOR x=10 TO 410 STEP 50 LINE(x,y)-(x+35,y1),1,bf:LINE (x,y)-(x+35,y1),3,b:LINE(x+1,y)-(x+34,y1),3,b NEXT LINE(7,35)-(28,139),3,b:PAINT(6,33),1,3 LINE(15,31)-(21,34),0,bf:LINE(11,31)-(18,28),0:LINE -(25,31),0:LINE -(11,31),0 LINE(15,140)-(21,143),0,bf:LINE(11,143)-(18,146),0:LINE -(25,143),0:LINE -(11,143),0 PAINT(18,30),0:PAINT(18,144),0 tabaktiv=1 GOSUB Rechnertasten GOSUB Tabkopf GOSUB Bildein GOSUB Screenup RETURN Tabkopf: LOCATE 2,3:PRINT dateiname$ LOCATE 2,37:PRINT "Aktuelle Zeitmaske: "zeitstart$" bis "zeitende$ RETURN Bildein: speed=10 FOR y%=speed TO 1 STEP-1 FOR x%=0 TO 7 PALETTE x%,r(x%)/y%,g(x%)/y%,b(x%)/y% NEXT x%,y% RETURN Bildaus: speed=1000 FOR y%=1 TO speed STEP 100 FOR x%=0 TO 7 PALETTE x%,r(x%)/y%,g(x%)/y%,b(x%)/y% NEXT x%,y% RETURN Rechner: calcpos%=INT((MOUSE(2)-24)/8) calcnr%=showstart+calcpos%:calc%(calcnr%)=1-calc%(calcnr%) IF tagkorflag%=1 THEN Tagkor1 GOSUB Listenprint GOSUB Summenprint RETURN Summenprint: IF rechenwert<-999999 OR rechenwert>9999999 THEN fehler=1 IF summe<-999999 OR summe>9999999 THEN fehler=1 IF fehler=1 THEN LOCATE 21,68:PRINT SPACE$(10):LOCATE 21,71 :PRINT "ERROR" :fehler=0 IF funktion<10 THEN y0=158:y1=168:x=50*(funktion-1)+10:LINE(x,y0)-(x+35,y1),3,b summe=0:rechenwert=0 RETURN END IF IF calcmodus%<>0 THEN LOCATE 21,68:PRINT USING "#######.##";rechenwert ELSE LOCATE 21,68:PRINT USING "#######.##";summe END IF RETURN Rechnerfunktion: funktion=INT((MOUSE(1)-5)/50+1) IF funktion>9 THEN LOCATE 21,68:PRINT SPACE$(10):LOCATE 21,68:laenge=10 type%=1:msgs$="":GOSUB Superinput rechenwert=VAL(msgs$) IF calcmodus%=0 THEN calcmodus%=1 GOSUB Summenprint RETURN END IF IF funktion<10 THEN y0=158:y1=168:x=50*(funktion-1)+10:LINE(x,y0)-(x+35,y1),2,b END IF IF funktion=1 THEN rechenwert=gesamtbe:GOSUB Summenprint:GOTO Weiter29 IF funktion=2 THEN Loeschen IF funktion=3 THEN IF calcmodus%<>0 THEN speicherwert=rechenwert::ELSE:speicherwert=summe END IF IF funktion=4 THEN rechenwert=speicherwert:GOSUB Summenprint:GOTO Weiter29 IF funktion<10 THEN IF calcmodus%=1 THEN summe=summe+rechenwert IF calcmodus%=2 THEN summe=summe-rechenwert IF calcmodus%=3 THEN summe=summe*rechenwert IF calcmodus%=4 THEN IF rechenwert=0 THEN fehler=1 :GOSUB Summenprint :RETURN END IF summe=summe/rechenwert END IF rechenwert=0 calcmodus%=0 GOSUB Summenprint END IF IF funktion>4 AND funktion<9 THEN calcmodus%=funktion-4 Weiter29: IF funktion<10 THEN y0=158:y1=168:x=50*(funktion-1)+10:LINE(x,y0)-(x+35,y1),3,b END IF RETURN Loeschen: calcmodus%=1 IF funktion<9 THEN y0=158:y1=168:x=50*(funktion-1)+10:LINE(x,y0)-(x+35,y1),3,b END IF rechenwert=0:summe=0:GOSUB Summenprint RETURN Superinput: WHILE INKEY$<>"":WEND GOSUB Spacekiller msgs$=LEFT$(msgs$,laenge) GOSUB Editor GOSUB Spacekiller type%=0 RETURN Spacekiller: IF msgs$=" " OR msgs$="" THEN msgs$="":RETURN WHILE MID$(msgs$,LEN(msgs$),1)=" " AND LEN(msgs$)>1 msgs$=LEFT$(msgs$,LEN(msgs$)-1) WEND RETURN Bestaetigung: MOUSE OFF IF request%=3 THEN LOCATE ttextwl,ttextwp:COLOR 1:PRINT"Weiter" LOCATE ttextrl,ttextrp:COLOR 1:PRINT"Richtig": LOCATE ttextfl,ttextfp:COLOR 2:PRINT"Falsch":COLOR 1 IF request%=3 THEN txwpos%=ttextwp*8-22:tywpos%=ttextwl*8-13 txrpos%=ttextrp*8-19:tyrpos%=ttextrl*8-13 txfpos%=ttextfp*8-22:tyfpos%=ttextfl*8-13 IF request%=3 THEN LINE(txwpos%,tywpos%)-(txwpos%+75,tywpos%+17),3,b LINE(txwpos%+4,tywpos%+2)-(txwpos%+71,tywpos%+15),3,b END IF LINE(txrpos%,tyrpos%)-(txrpos%+75,tyrpos%+17),3,b LINE(txrpos%+4,tyrpos%+2)-(txrpos%+71,tyrpos%+15),3,b LINE(txfpos%,tyfpos%)-(txfpos%+75,tyfpos%+17),3,b LINE(txfpos%+4,tyfpos%+2)-(txfpos%+71,tyfpos%+15),3,b RETURN Mouseposition: fehler=3:IF hlf%=1 THEN Weiter27 xpos=MOUSE(3): ypos=MOUSE(4) IF request%=3 THEN IF xpos>txwpos% AND xpostywpos% AND ypostxrpos% AND xpostyrpos% AND ypostxfpos% AND xpostyfpos% AND ypos0 THEN PRINT #1,USING "#######.##";VAL(RIGHT$(ds$(show%(x%)),10)); END IF ELSE PRINT #1,USING "\ \";MID$(show$(x%),3,LEN(show$(x%))-12); IF VAL(RIGHT$(show$(x%),10))<>0 THEN PRINT #1,USING "#######.##";VAL(RIGHT$(show$(x%),10)); END IF END IF PRINT #1,CHR$(13) IF INKEY$=CHR$(27) THEN Abbruch WEND GOSUB Strich PRINT #1,"Im Gesamten wurden für die gewählten Konten laut Zeitmaske "; PRINT #1,CHR$(27)"[1m"; PRINT #1,USING "########.##";gesamtbe; PRINT #1,CHR$(27)"[22m"; PRINT #1," "waehrung$" aufgewendet !" GOSUB Strich GOSUB Seitenumbruch CLOSE #1 operationstext$="Druckoperation fertig !":GOSUB Operationsmeldung printakt%=0:GOSUB Tabmaske:GOTO Tabausgabe Markieren: IF m%(x%,y%)=1 THEN mp$(x%,y%)="* "+m$(x%,y%) PRINT #1,CHR$(27)"[1m"; ELSE mp$(x%,y%)=" "+m$(x%,y%) PRINT #1,CHR$(27)"[22m"; END IF PRINT #1,USING "\ \" ;mp$(x%,y%); RETURN Markieren1: IF m%(x%,y%)=1 THEN COLOR 2 ELSE COLOR 1 END IF CALL Text (WINDOW(8),SADD(m$(x%,y%)),LEN(m$(x%,y%))) RETURN Abbruch: CLOSE #1 fehlertext$="Druckoperation abgebrochen !":GOSUB Fehlermeldung printakt%=0:GOSUB Tabmaske:tabaktiv=0:GOTO Tabausgabe Strich: FOR y%=1 TO 87:PRINT #1,"_";:NEXT:PRINT #1,CHR$(13):PRINT #1,CHR$(13) RETURN Umblaettern: IF z%=40+(60*(pagenr-1)) THEN RETURN GOSUB Strich :pagec=pagec+1 PRINT #1,CHR$(27)"[1m"; FOR y%=1 TO 5:PRINT #1,CHR$(13):NEXT GOSUB Strich PRINT #1,"Tabelle vom "; PRINT #1,USING "\ \";pdatum$; PRINT #1," "; PRINT #1,USING "\ \";pkom$; PRINT #1," (Fortsetzung) Seite "; PRINT #1,USING "##";pagec; GOSUB Strich PRINT #1,CHR$(27)"[22m"; RETURN Seitenumbruch: vz%= (pagenr*60+5-z%)-20:IF pagenr=1 THEN vz%=45-z% FOR y%=1 TO vz% :PRINT #1,CHR$(27)"d":NEXT RETURN Bubblesort: sortlg%=INT(anzahl%/2)+1:sortrg%=anzahl% Loop1: IF sortrg%<=1 THEN GOTO Windowclose3 Loop2: IF sortlg%<=1 THEN Loop3 sortlg%=sortlg%-1 sorti%=sortlg%:GOTO Loop4 Loop3: SWAP ds$(1),ds$(sortrg%) sortrg%=sortrg%-1 sorti%=1 Loop4: sortx$=ds$(sorti%) sortp%=0 Loop5: IF 2*sorti%<=sortrg% AND sortp%=0 THEN Loop6 ds$(sorti%)=sortx$ GOTO Loop1 Loop6: sortj%=2*sorti% IF sortj%=MID$(ds$(sortj%),4,8) THEN Loop7 ds$(sorti%)=ds$(sortj%) sorti%=sortj%:GOTO Loop5 Loop7: sortp%=1:GOTO Loop5 Variablendim: DIM m$(8,8) DIM monat$(12) DIM kontoart$(8,8) DIM hilfefile$(2,15) DIM mp$(7,7),ma%(7) DIM m%(7,15) DIM koliste%(30) DIM koliste$(30) DIM knum$(30) DIM kges(88) DIM gges(88) DIM mges(1,12) DIM balken%(310) DIM c%(64),cs%(64) DIM dsmem$(50) DIM show$(26) datenmenge=INT((FRE(0)-5000)/108) IF datenmenge>999 THEN datenmenge=999 DIM ds$(datenmenge),show%(datenmenge) DIM calc%(datenmenge) DIM sortlg%(datenmenge) DIM sortrg%(datenmenge) RETURN Datalesen: RESTORE Monatsnamen FOR x%=1 TO 12:READ monat$(x%) NEXT RESTORE Wochentage FOR x%=0 TO 6:READ wt$(x%) NEXT RESTORE Hilfefiledatas FOR y%=0 TO 1:FOR x%=0 TO 14 READ hilfefile$(y%,x%) NEXT x%,y% RETURN Farbeinstellung: RESTORE Farben FOR x%=0 TO 7:READ r(x%),g(x%),b(x%):PALETTE x%,r(x%),g(x%),b(x%):NEXT RETURN Hilfefiledatas: DATA Konten,Eingeben,Eingaben USINGndern,Zeitmaske DATA Datum USINGndern,Filtertext,WUSINGhrung,Dateien DATA Kontenlisten,Sortieren,Importieren DATA Exportieren,,,,,Tabelle Bildschirm,Tabelle Drucken, DATA Alle Konten,Gesamt,Detailiert,Filter DATA Sort.n.Konten,Sort.n.Datum,Monatsabrechnung,, DATA Selektieren,Selektinvert,Selektloeschen Farben: DATA 0,0,0,1,1,1,1,.2,.2,1,.7,.2,1,1,0,.3,.3,1,.7,.7,1,.5,.5,1 Wochentage: DATA "Montag ","Dienstag ","Mittwoch ","Donnerstag" DATA "Freitag ","Samstag ","Sonntag " Monatsnamen: DATA "Jänner ","Februar ","März ","April ","Mai ","Juni " DATA "Juli ","August ","September","Oktober ","November ","Dezember " Windowclose3: WINDOW CLOSE 3:WINDOW 1 RETURN Datenein: CLOSE #2:diskfehler=0 header$=ds$(0) OPEN dateiname$ FOR INPUT AS #2 INPUT#2,ds$(0) IF LEFT$(ds$(0),2)="00" THEN Weiter10 fehlertext$="Die Datei hat eine falsche Datenstruktur !" diskfehler=4:dateiname$=altdn$:ds$(0)=header$ CLOSE #2:GOTO Fehlermeldung Weiter10: ERASE m%,show%,show$:DIM m%(7,15),show%(datenmenge),show$(30) GOSUB Systemsetsave dzeitstart$=MID$(ds$(0),4,8):dzeitende$=MID$(ds$(0),13,8) IF zeitstart$dzeitende$ THEN zeitstart$=dzeitstart$:zeitende$=dzeitende$ END IF d0zeitstart$=dzeitstart$:d0zeitende$=dzeitende$ Kontenliste$=RIGHT$(ds$(0),LEN(ds$(0))-21) Importein: IF eximfl<>1 THEN anzahl%=0 Loop12: diskfehler=0 IF EOF(2) THEN Loop13 INPUT#2,ds$(anzahl%+1) IF diskfehler>0 THEN fehlertext$="Schadhafte Datenstruktur !" diskfehler=0:eximfl=0:GOTO Fehlermeldung END IF anzahl%=anzahl%+1 IF anzahl%>datenmenge-1 THEN CLOSE #2:anzahl%=0:GOTO Datenueberlauf GOTO Loop12 Loop13: CLOSE #2 RETURN Datenueberlauf: IF eximfl=1 THEN anzahl%=altanzahl% fehlertext$="Datei zu groß ! Daten einlesen abgebrochen !" GOTO Fehlermeldung Rueckschreiben: MOUSE OFF:MENU OFF CLOSE #2 diskfehler=0 OPEN dateiname$ FOR OUTPUT AS #2 IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Rueckschreiben PRINT #2,ds$(0) x%=1 WHILE x%<=anzahl% IF VAL(RIGHT$(ds$(x%),10))<>0 THEN PRINT #2,ds$(x%) IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Rueckschreiben x%=x%+1 WEND CLOSE #2 RETURN Konteneinlesen: ml%=0:diskfehler=0:CLOSE #2 OPEN Kontenliste$ FOR INPUT AS#2 INPUT#2,dummy$ IF dummy$<>"11" OR diskfehler=2 THEN Kolesefehler ERASE m$,ma%,kontoart$:DIM m$(8,8),ma%(8),kontoart$(8,8) FOR x%=3 TO 7 INPUT#2,ma%(x%) FOR y%=0 TO ma%(x%) INPUT#2,m$(x%,y%) INPUT#2,kontoart$(x%,y%) IF m$(x%,y%)<>"" THEN ml%=x%-2 NEXT y%,x% CLOSE #2 RETURN Kolesefehler: CLOSE #2 fehlertext$="Kontenliste hat falsches Datenformat !" GOTO Fehlermeldung Kontensave: operationstext$="Ich speichere nun die Kontenliste !" flag=1:GOSUB Operationsmeldung FOR x%=3 TO 7:FOR y%=0 TO 6 IF m$(x%,y%)<>"" THEN ma%(x%)=y% NEXT y%,x% CLOSE #2 diskfehler=0 OPEN Kontenliste$ FOR OUTPUT AS #2 IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Kontensave PRINT#2,"11" FOR x%=3 TO 7 PRINT#2,ma%(x%) FOR y%=0 TO ma%(x%) PRINT#2,m$(x%,y%) PRINT#2,kontoart$(x%,y%) IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Kontensave NEXT y%,x% CLOSE #2 GOTO Windowclose3 Systemsetsave: diskfehler=0:CLOSE #3 OPEN "Haushaltssystem/Systemset" FOR OUTPUT AS#3 IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Systemsetsave PRINT #3,dateiname$ PRINT #3,Kontenliste$ PRINT #3,detailflag%,gesamtflag%,sortflag% PRINT #3,waehrung$ PRINT #3,zeitstart$ PRINT #3,zeitende$ IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Systemsetsave CLOSE #3 RETURN Systemsetload: CLOSE #2:diskfehler=0 OPEN "Haushaltssystem/Systemset" FOR INPUT AS#2 IF diskfehler>0 THEN fehlertext$="Oh weh. Mir fehlt mein SYSTEMSET File !" GOSUB Fehlermeldung:RETURN END IF INPUT #2,dateiname$ INPUT #2,Kontenliste$ INPUT #2,detailflag%,gesamtflag%,sortflag% INPUT #2,waehrung$ INPUT #2,zeitstart$ INPUT #2,zeitende$ CLOSE #2 RETURN Systemset: datum$=RIGHT$(DATE$,2)+"-"+LEFT$(DATE$,2)+"-"+MID$(DATE$,4,2) zeitstart$="80-01-01" dzeitstart$=zeitstart$ zeitende$="99-12-31" dzeitende$=zeitende$ d0zeitstart$=zeitstart$ d0zeitende$=zeitende$ seitendruck=1 waehrung$="ÖS" detailflag%=1 sortflag%=1 bildzeilen=16 dateienmax=20 kontenlmax=20 dateiname1$="Haushaltsdaten/" RETURN Import: eximfl=1 GOTO Loopvor Export: eximfl=0 Loopvor: IF eximfl=0 THEN WINDOW 3,"Daten exportieren:",(80,50)-(550,140),0,1 IF eximfl=1 THEN WINDOW 3,"Daten importieren:",(80,50)-(550,140),0,1 PALETTE 3,0,0,0 LOCATE 5,16:PRINT "Bitte Dateinamen eingeben !" LINE (54,50)-(408,68),3,b:LINE (69,54)-(393,64),3,b PAINT (55,51),3 PALETTE 3,r(3),g(3),b(3) LOCATE 8,10:laenge=39:msgs$=dateiname1$:GOSUB Superinput:dateiname1$=msgs$ diskfehler=0 OPEN dateiname1$ FOR INPUT AS #2 CLOSE #2 IF diskfehler=0 THEN Dateivorhanden IF eximfl=1 THEN fehlertext$="Datei nicht vorhanden" GOTO Fehlermeldung END IF WINDOW 3,"Dateien Exportieren:",(80,50)-(550,140),0,1 LOCATE 4,15:PRINT " Dateiname für Export frei." LOCATE 6,15:PRINT "Wollen Sie nun exportieren ?" fehler=3 ttextrl=9:ttextrp=20:ttextfl=9:ttextfp=34:mskip=0:GOSUB Bestaetigung mousep%=10:RETURN Mp10: mousep%=0 IF fehler=1 THEN Windowclose3 GOTO Exportieren Dateivorhanden: IF eximfl=0 THEN WINDOW 3,"Daten exportieren:",(80,50)-(550,140),0,1 LOCATE 4,12:PRINT " Dateiname schon vorhanden." LOCATE 6,12:PRINT "Wollen Sie diese Datei überschreiben ?" END IF IF eximfl=1 THEN WINDOW 3,"Daten Importieren:",(80,50)-(550,140),0,1 LOCATE 4,12:PRINT " Dateiname vorhanden." LOCATE 6,12:PRINT " Wollen Sie diese Datei importieren ?" END IF fehler=3 ttextrl=9:ttextrp=20:ttextfl=9:ttextfp=34:mskip=0:GOSUB Bestaetigung mousep%=11:RETURN Mp11: mousep%=0 IF fehler=1 THEN GOTO Windowclose3 IF eximfl=0 THEN Exportieren Importieren: diskfehler=0 OPEN dateiname1$ FOR INPUT AS #2 IF diskfehler>0 THEN CLOSE #2:GOTO Fehlermeldung INPUT#2,dummy$ IF LEFT$(dummy$,2)<>"22" THEN fehlertext$="Datenformat falsch !!!!" CLOSE #2:GOTO Fehlermeldung END IF IF dummy$<>"22 "+Kontenliste$ THEN WINDOW 3,"Warnung:",(80,50)-(550,140),0,1 LOCATE 4,15:PRINT " Kontenlisten nicht gleich." LOCATE 6,15:PRINT "Wollen Sie trotzdem importieren ?" ttextrl=9:ttextrp=20:ttextfl=9:ttextfp=34:mskip=0:GOSUB Bestaetigung mousep%=12:RETURN Mp12: mousep%=0 IF fehler=1 THEN CLOSE#2:GOTO Windowclose3 END IF CLS LOCATE 4,14:PRINT " Sollen die Importierten Daten" LOCATE 6,14:PRINT " in die Datei eingebunden werden ?" ttextrl=9:ttextrp=20:ttextfl=9:ttextfp=34:mskip=0:GOSUB Bestaetigung mousep%=15:RETURN Mp15: mousep%=0 IF fehler=0 THEN fiximp%=1::ELSE:fiximp%=0 altanzahl%=anzahl% GOSUB Importein:eximfl=0 IF fiximp%=1 THEN GOSUB Rueckschreiben GOTO Windowclose3 Exportieren: IF z%<1 THEN fehlertext$="Keine Daten zum Exportieren vorhanden !" GOTO Fehlermeldung END IF IF LEFT$(show$(1),2)="00" THEN fehlertext$="Monatsabrechnungen können nicht exportiert werden!" GOTO Fehlermeldung END IF diskfehler=0 OPEN dateiname1$ FOR OUTPUT AS #2 IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Exportieren IF diskfehler>0 THEN CLOSE #2:GOTO Fehlermeldung END IF PRINT#2,"22 "Kontenliste$ FOR x%=1 TO z% IF gesamtakt%=1 THEN PRINT#2,show$(x%) ELSE PRINT#2,ds$(show%(x%)) END IF IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Exportieren NEXT x% CLOSE #2 GOTO Windowclose3 Konten: MENU OFF:MOUSE OFF WINDOW 3,"Kontenlisten aktuallisieren:",(80,50)-(550,140),0,1 PALETTE 3,0,0,0 LOCATE 5,14:PRINT "Bitte Kontenlistenname eingeben !" LINE (54,50)-(408,68),3,b:LINE (69,54)-(393,64),3,b PAINT (55,51),3 PALETTE 3,r(3),g(3),b(3) alkoli$=Kontenliste$ IF Kontenliste$="" THEN Kontenliste$="Haushaltskonten/" LOCATE 8,10:laenge=39:msgs$=Kontenliste$:GOSUB Superinput Kontenliste$=msgs$ diskfehler=0 OPEN Kontenliste$ FOR INPUT AS #2 CLOSE #2 IF diskfehler=0 THEN GOSUB Konteneinlesen:GOTO Kontenmaske WINDOW 3,"Kontenlisten Aktuallisieren:",(80,50)-(550,140),0,1 LOCATE 4,9:PRINT "Ich habe diese Kontenliste nicht gefunden !" LOCATE 6,9:PRINT "Wollen Sie diese Kontenliste neu erstellen ?" fehler=3 ttextrl=9:ttextrp=20:ttextfl=9:ttextfp=34:GOSUB Bestaetigung mousep%=13:RETURN Mp13: mousep%=0 IF fehler=1 THEN Kontenliste$=alkoli$:GOTO Windowclose3 ERASE m$,ma%,kontoart$:DIM m$(8,6),ma%(8),kontoart$(8,6) Kontenmaske: GOSUB Windowclose3 kontenaktiv%=1 MOUSE ON :MENU OFF GOSUB Bildaus CLS LINE(15,5)-(625,17),2,b LOCATE 2,5:PRINT"Kontenliste :" LOCATE 2,19:PRINT Kontenliste$ LINE(15,37)-(625,115),3,bf:LINE(15,21)-(625,35),3,bf FOR x%=0 TO 4 LOCATE 4,x%*15+4:PRINT SPACE$(9) LOCATE 4,x%*15+4:PRINT m$(x%+3,0) NEXT FOR x%=0 TO 4:FOR y%=1 TO 5 LOCATE y%*2+4,x%*15+4:PRINT SPACE$(10) LOCATE y%*2+4,x%*15+4:PRINT m$(x%+3,y%+1) LOCATE y%*2+4,x%*15+15:PRINT SPACE$(3) LOCATE y%*2+4,x%*15+15:PRINT kontoart$(x%+3,y%+1) NEXT y%,x% FOR x%=1 TO 4 LINE(120*x%+19,21)-(120*x%+20,115),0,b LINE(15,x%*16+36)-(625,x%*16+36),0,b NEXT ttextrl=18:ttextrp=28:ttextfl=18:ttextfp=45:GOSUB Bestaetigung GOSUB Bildein RETURN Kontenmousecheck: IF MOUSE(2)>115 THEN GOSUB Mouseposition:GOTO Kontentasten IF MOUSE(1)<=20 OR MOUSE(1)>=625 THEN RETURN IF MOUSE(2)<=20 THEN RETURN xwert%=INT((MOUSE(1)-20)/120) ywert%=INT((MOUSE(2)-20)/16) MOUSE OFF IF ywert%=0 THEN LOCATE ywert%*2+4,xwert%*15+4:msgs$=m$(xwert%+3,ywert%):laenge=8 GOSUB Superinput:m$(xwert%+3,ywert%)=msgs$:m$(xwert%+3,ywert%+1)=msgs$ MOUSE ON:RETURN END IF LOCATE ywert%*2+4,xwert%*15+4:msgs$=m$(xwert%+3,ywert%+1):laenge=9 GOSUB Superinput:m$(xwert%+3,ywert%+1)=msgs$ Kontenart: LOCATE ywert%*2+4,xwert%*15+15:msgs$=kontoart$(xwert%+3,ywert%+1):laenge=2 GOSUB Superinput:kontoart$(xwert%+3,ywert%+1)=msgs$ IF msgs$="+" OR msgs$="-" OR msgs$="-u" OR msgs$="+u" THEN Weiter11 kontoart$(xwert%+3,ywert%+1)="+":GOTO Kontenart Weiter11: MOUSE ON RETURN Kontentasten: IF fehler=3 THEN RETURN IF fehler=0 THEN GOSUB Kontensave IF fehler=1 THEN Kontenliste$=alkoli$ operationstext$="Ich Aktuallisiere die Kontenliste !" flag=1:GOSUB Operationsmeldung GOSUB Konteneinlesen GOSUB Machkonten kontenaktiv%=0 tabaktiv=0 GOSUB Windowclose3 GOSUB Tabmaske GOTO Tabausgabe Openwindow3: MENU OFF:MOUSE OFF WINDOW 3,windowtext$,(80,50)-(550,140),0,1 RETURN Autor: windowtext$="Der Autor !!!!!!!!!!! ":GOSUB Openwindow3 CLS LOCATE 2,25:PRINT"Sauer Franz" LOCATE 3,20:PRINT"Senefeldergasse 58/28" LOCATE 4,25:PRINT"A-1100 Wien" LOCATE 5,13:PRINT"Tel. (Österreich) 0222 / 62 68 383" LOCATE 7,7: PRINT"Sollten noch Fragen zum Programm auftreten so" LOCATE 8,7: PRINT"richten Sie sich bitte an die oben angegebene" LOCATE 9,7: PRINT"Adresse. Ich bin gerne bereit zu helfen. Ich " LOCATE 10,7:PRINT"hoffe Sie können mein Programm nutzen." fakt%=1 RETURN Hilfe: MOUSE OFF WINDOW 3,"Hilfe !!!!!!!",(80,50)-(550,140),0,1 LOCATE 2,25:PRINT "Hilferoutine" LOCATE 4,7:PRINT " Durch Anwählen eines Menüpunktes erhalten Sie" LOCATE 5,7:PRINT "eine Ausführliche Beschreibung der jeweiligen" LOCATE 6,7:PRINT "Funktion. Durch Drücken einer beliebigen Taste" LOCATE 7,7:PRINT "blättern Sie nach vor.Durch 'Mouseclick' unter-" LOCATE 8,7:PRINT "brechen Sie die Hilferoutine und kehren wieder" LOCATE 9,7:PRINT "ins Hauptprogramm zurück. Wählen Sie nun bitte" LOCATE 10,7:PRINT"einen Menüpunkt. hilfeflag%=1 RETURN Hilferoutine: WHILE INKEY$<>"":WEND hilfeflag%=0 IF leiste>2 THEN punkte=0:leiste=1 IF punkte>14 OR hilfefile$(leiste-1,punkte)="" THEN fehlertext$="Dafür gibt es keinen Hilfetext !" GOTO Fehlermeldung END IF diskfehler=0:CLOSE #2 OPEN "Hilfe/"+hilfefile$(leiste-1,punkte) FOR INPUT AS#2 IF diskfehler=0 THEN Hilfeladen fehlertext$="Sorry, mir hat jemand das Hilfefile gestohlen !" CLOSE #2 GOTO Fehlermeldung Hilfeladen: WINDOW 3,"Beschreibung für "+hilfefile$(leiste-1,punkte),(80,50)-(550,140),0,1 hzeile%=1:hlf%=1 Weiter13: IF EOF(2) THEN Weiter14 LINE INPUT#2,zeighilfe$ IF hzeile%>9 THEN mousep%=16 RETURN Mp16: mousep%=0 hzeile%=1:CLS IF tdr=0 THEN Weiter15 END IF hzeile%=hzeile%+1:hlaenge%=LEN(zeighilfe$)*8 LOCATE hzeile%,1 IF zeighilfe$<>"" THEN PRINT PTAB(240-hlaenge%/2)zeighilfe$ tdr=0:GOTO Weiter13 Weiter14: mousep%=17 RETURN Mp17: mousep%=0 Weiter15: hlf%=0:CLOSE #2 GOTO Windowclose3 Sysst: windowtext$="Systemstatus:":GOSUB Openwindow3 LOCATE 2,2:PRINT "Aktuelle Datei :"dateiname$ LOCATE 3,2:PRINT "Aktuelle Kontenliste :"Kontenliste$ LOCATE 4,2:PRINT "Zeitbereich der Datei:"d0zeitstart$" bis "d0zeitende$ LOCATE 5,2:PRINT "Aktuelle Zeitmaske :"zeitstart$" bis "zeitende$ LOCATE 6,2:PRINT "--------------------------------------------------------" LOCATE 7,2:PRINT "Dateigröße :"datenmenge" Verbraucht:"anzahl%" Frei:"datenmenge-anzahl% LOCATE 8,2:PRINT "--------------------------------------------------------" LOCATE 9,2:PRINT "Freie Bytes im Systemspeicher :"FRE(-1) LOCATE 10,2:PRINT "Freie Bytes für Haushaltsdaten :"FRE(0) fakt%=1 RETURN Wae: WINDOW 3,"Währungszeichen ändern:",(180,60)-(450,140),0,1 LOCATE 2,2:PRINT "Bitte Währungszeichen eingeben." LINE (90,29)-(180,42),3,bf LOCATE 5,16:PRINT SPACE$(3):msgs$=waehrung$:laenge=2 LOCATE 5,16:GOSUB Superinput:waehrung$=msgs$ ttextrl=8:ttextrp=9:ttextfl=8:ttextfp=22:GOSUB Bestaetigung mousep%=14:RETURN Mp14: mousep%=0 IF fehler=1 THEN Windowclose3 WINDOW 1:LOCATE 21,58:PRINT "Gesamt " LOCATE 21,65:PRINT waehrung$ GOSUB Systemsetsave GOTO Windowclose3 Cursor: LINE (0,0)-(7,7),2,bf GET (0,0)-(7,7),c% GET (0,0)-(1,7),cs% LINE (0,0)-(7,7),0,bf RETURN Openlibrarys: diskfehler=0 LIBRARY "graphics.library" IF diskfehler>0 THEN fehlertext$="Graphics Library nicht vorhanden !" GOSUB Fehlermeldung:SYSTEM END IF LIBRARY "exec.library" IF diskfehler>0 THEN fehlertext$="Exec Library nicht vorhanden !" GOSUB Fehlermeldung:SYSTEM END IF LIBRARY "intuition.library" IF diskfehler>0 THEN fehlertext$="Intuition Library nicht vorhanden !" GOSUB Fehlermeldung:SYSTEM END IF RETURN Mcp: dummy=MOUSE(0):xpos%=MOUSE(3):ypos%=MOUSE(4) IF xpos%>(offset%)*8 AND xpos%<(offset%+laenge)*8 THEN IF ypos%>(y%-1)*8-3 AND ypos%CHR$(13) in$="" Loop25: SLEEP in$=INKEY$ IF in$<>"" OR mcpos%>=0 THEN Loop26 GOTO Loop25 Loop26: IF mcpos%<0 THEN bx%=x% IF in$=CHR$(8) THEN '[BACKSPACE] in$="" wipe%=1 IF x%>0 THEN x%=x%-1 ELSEIF in$=CHR$(127) THEN '[DEL] in$="" wipe%=1 END IF IF (in$>=CHR$(lo) AND in$<=CHR$(hi)) OR (in$>=CHR$(r1)AND in$<=CHR$(r2)) OR in$="" THEN add$=LEFT$(backup$,x%)+in$ IF x%=LEN(backup$) THEN backup$=add$ ELSEIF x%>LEN(backup$) THEN diff%=x%-LEN(backup$) backup$=backup$+SPACE$(diff%)+in$ ELSE backup$=add$+RIGHT$(backup$,LEN(backup$)-x%-mode%) END IF IF wipe%=1 THEN wipe%=0 ELSE x%=x%+1 END IF ELSEIF in$=CHR$(27) THEN '[INSERT] SWAP mode%,bu% ELSEIF in$=CHR$(31) THEN '[CSRLEFT] IF x%>0 THEN x%=x%-1 ELSE BEEP END IF ELSEIF in$=CHR$(30) THEN '[CSRRIGHT] x%=x%+1 END IF IF bu%=0 THEN PUT ((bx%+LEN(prompt$)+offset%)*8,(y%-1)*8),c%,XOR ELSE PUT ((bx%+LEN(prompt$)+offset%)*8,(y%-1)*8),cs%,XOR END IF IF type%=3 THEN IF x%>0 THEN x%=x%-1 ELSEIF x%>max% THEN x%=x%-1 BEEP END IF IF LEN(backup$)>max% THEN backup$=LEFT$(backup$,max%) BEEP END IF LOCATE y%,ox%+offset% bu$=backup$+SPACE$(1) CALL Text(WINDOW(8),SADD(bu$),LEN(bu$)) GOSUB Putc ELSE GOSUB Putc x%=mcpos%:mcpos%=-1 GOSUB Putc END IF MOUSE ON WEND GOSUB Putc msgs$=backup$ ed%=0 RETURN Putc: IF bu%=0 THEN PUT ((x%+LEN(prompt$)+offset%)*8,(y%-1)*8),c%,XOR ELSE PUT ((x%+LEN(prompt$)+offset%)*8,(y%-1)*8),cs%,XOR END IF RETURN RETURN Guru: alertnum&=0 res&=DisplayAlert&(alertnum&,SADD(errText1$),56) GOTO Ende Outoffmemtext: errText1$=CHR$(0)+CHR$(96)+CHR$(20)+"Oh weh, oh weh, da ist ein schwerer Fehler aufgetreten !" errText1$=errText1$+CHR$(0)+CHR$(1)+CHR$(0)+CHR$(72)+CHR$(30)+"Ich sehe mich daher leider gezwungen das Programm zu Beenden." errText1$=errText1$+CHR$(0)+CHR$(1)+CHR$(0)+CHR$(168)+CHR$(40)+"Drücken Sie nun die linke Maustaste." errText$=CHR$(0)+CHR$(96)+CHR$(20)+"Jetzt haben Sie es geschafft . Mir ist der Speicher" errText$=errText$+CHR$(0)+CHR$(1)+CHR$(0)+CHR$(96)+CHR$(28)+"ausgegangen. Versuchen Sie eventuell geöffnete Fenster" errText$=errText$+CHR$(0)+CHR$(1)+CHR$(0)+CHR$(96)+CHR$(36)+"zu schließen oder Programme die noch Speicher belegen" errText$=errText$+CHR$(0)+CHR$(1)+CHR$(0)+CHR$(96)+CHR$(44)+"wegzuräumen . Sollte ich wieder mehr als 30000 Bytes" errText$=errText$+CHR$(0)+CHR$(1)+CHR$(0)+CHR$(96)+CHR$(52)+"freien Systemspeicher vorfinden so können Sie mit viel" errText$=errText$+CHR$(0)+CHR$(1)+CHR$(0)+CHR$(96)+CHR$(60)+"Glück ihre Arbeit fortsetzen." errText$=errText$+CHR$(0)+CHR$(1)+CHR$(0)+CHR$(168)+CHR$(82)+"Drücken Sie nun die Linke Maustaste." errText$=errText$+CHR$(0) RETURN Outoffmem: alertnum&=0 res&=DisplayAlert&(alertnum&,SADD(errText$),100) GOSUB Mouseclick IF ERR=7 THEN RUN RETURN Screendown: FOR x%=1 TO 28 sc&=PEEKL(WINDOW(7)+46) CALL MoveScreen(sc&,0,10) NEXT RETURN Screenup: FOR x%=1 TO 28 sc&=PEEKL(WINDOW(7)+46) CALL MoveScreen(sc&,0,-10) NEXT RETURN Declarieren: IF alreadydeclared = 0 THEN DECLARE FUNCTION DisplayAlert& LIBRARY DECLARE FUNCTION AllocSignal%() LIBRARY DECLARE FUNCTION AllocMem&() LIBRARY DECLARE FUNCTION FindTask&() LIBRARY DECLARE FUNCTION DoIO&() LIBRARY DECLARE FUNCTION OpenDevice& LIBRARY alreadydeclared = 1 END IF RETURN